home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1994 December
/
PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin
/
prgmming
/
dos
/
pascal1
/
parscl.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-12-21
|
4KB
|
146 lines
Unit ParseCL;
interface
{*****************************************************************}
type
ValueType = (_Real, _Integer, _String);
CLParPtr = ^CLParType;
CLParType = record
Fwd,
Bkwd : CLParPtr;
SwName : String;
Case VType : ValueType of
_Real : (VReal : Real);
_Integer : (VInt : LongInt);
_String : (VString : String);
end;
Procedure ParseCmdLine(StrPtr : Pointer; StrOnly : Boolean;
var X : CLParPtr; var Err : Integer );
{*****************************************************************}
implementation
{*****************************************************************}
Procedure ParseCmdLine(StrPtr : Pointer; StrOnly : Boolean;
var X : CLParPtr; var Err : Integer );
var
CmdLine : ^String;
CLine : String;
QuoteState : (Off, Quote1, Quote2);
Last,
Current : CLParPtr;
T1 : Integer;
Procedure PackCommandLine( var Err : Integer );
var
T1 : Integer;
begin
CLine := '';
QuoteState := Off;
For T1 := 1 to Length(CmdLine^) do
Case QuoteState of
Off : Case CmdLine^[T1] of
' ' : ;
'''' : QuoteState := Quote1;
'"' : QuoteState := Quote2;
else CLine := CLine + CmdLine^[T1];
end;
Quote1 : Case CmdLine^[T1] of
'''' : QuoteState := Off;
else CLine := CLine + chr(ord(CmdLine^[T1]) or $80);
end;
Quote2 : Case CmdLine^[T1] of
'"' : QuoteState := Off;
else CLine := CLine + chr(ord(CmdLine^[T1]) or $80);
end;
end;
If (Length(CLine) > 0) and (CLine[1] <> '/') then
CLine := '/' + CLine;
Err := ord(QuoteState);
end;
Procedure SetNextLink;
begin
New(Current);
Last^.Fwd := Current;
Current^.Fwd := Nil;
Current^.Bkwd := Last;
Last := Current;
end;
Procedure MakeSwitchRecord;
var
WorkSpace : String;
Err : Integer;
T1 : Integer;
begin
CLine := Copy(Cline, 2, Length(CLine)-1); {Strip leading '/'}
WorkSpace := CLine;
If Pos('/',WorkSpace) <> 0 then begin
WorkSpace[0] := chr(Pos('/',WorkSpace) - 1);
CLine := Copy(CLine, Pos('/',CLine),
Length(CLine)-Pos('/',CLine)+1);
end
else
CLine := '';
With Current^ do begin
If Pos('=',WorkSpace) <> 0 then begin
SwName := Copy(WorkSpace, 1, Pos('=',WorkSpace)-1);
WorkSpace := Copy(WorkSpace, Pos('=',WorkSpace)+1,
Length(WorkSpace)-Pos('=',WorkSpace));
end
else begin
SwName := WorkSpace;
WorkSpace := '';
end;
{Name has been set. Now get type and value}
If not StrOnly then begin
If Length(WorkSpace) = 0 then begin
VType := _String;
VString := '';
exit
end;
Val(WorkSpace, VInt, Err);
If Err = 0 then begin
VType := _Integer;
exit
end;
Val(WorkSpace, VReal, Err);
If Err = 0 then begin
VType := _Real;
exit
end;
end; {If not StrOnly}
VType := _String;
VString := '';
For T1 := 1 to Length(WorkSpace) do
VString := VString + chr(ord(WorkSpace[T1]) and $7F);
end
end;
begin {ParseCmdLine}
If StrPtr = nil then
CmdLine := Ptr(PrefixSeg, $0080)
else
CmdLine := StrPtr;
PackCommandLine(Err);
If Length(CLine) = 0 then begin
X := Nil;
exit
end;
New(Current);
X := Current;
Last := Current;
Current^.Fwd := Nil;
Current^.Bkwd := Nil;
MakeSwitchRecord;
While Pos('/',CLine) <> 0 do begin
SetNextLink;
MakeSwitchRecord;
end;
end; {ParseCmdLine}
{**********************************************************}
end.